home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / dir.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-23  |  17.2 KB  |  703 lines
  1. IMPLEMENTATION MODULE dir;
  2. __IMP_SWITCHES__
  3. #ifdef HM2
  4. #ifdef __LONG_WHOLE__
  5. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  6. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  7. #else
  8. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  9. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  10. #endif
  11. #endif
  12. (*****************************************************************************)
  13. (* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
  14. (*---------------------------------------------------------------------------*)
  15. (* 07-Nov-93, Holger Kleinschmidt                                            *)
  16. (*****************************************************************************)
  17.  
  18. VAL_INTRINSIC
  19. CAST_IMPORT
  20. PTR_ARITH_IMPORT
  21.  
  22. FROM SYSTEM IMPORT
  23. (* TYPE *) ADDRESS,
  24. (* PROC *) ADR, TSIZE;
  25.  
  26. FROM PORTAB IMPORT
  27. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, WORDSET;
  28.  
  29. FROM types IMPORT
  30. (* CONST*) EOS, NULL, DDIRSEP, PATHMAX,
  31. (* TYPE *) sizeT, StrPtr, StrRange, PathName;
  32.  
  33. FROM MEMBLK IMPORT
  34. (* PROC *) memalloc, memdealloc;
  35.  
  36. FROM OSCALLS IMPORT
  37. (* PROC *) Dcreate, Fchmod, Ddelete, Dgetdrv, Dsetdrv, Dsetpath, Dopendir,
  38.            Dreaddir, Drewinddir, Dclosedir, Dpathconf, Fdelete, Flink,
  39.            Fsymlink, Freadlink, Frename;
  40.  
  41. FROM ctype IMPORT
  42. (* PROC *) tocard;
  43.  
  44. FROM cstr IMPORT
  45. (* PROC *) AssignM2ToC, strcmp;
  46.  
  47. FROM pSTRING IMPORT
  48. (* PROC *) SLEN, ASSIGN, APPEND, EQUAL, LOWER;
  49.  
  50. IMPORT e;
  51.  
  52. FROM DosSystem IMPORT
  53. (* PROC *) MiNTVersion;
  54.  
  55. FROM DosSupport IMPORT
  56. (* CONST*) FINDALL, XDECR, DINCR,
  57. (* TYPE *) DTA, FileAttributes, FileAttribute,
  58. (* PROC *) CompletePath, DosToUnix, UnixToDos, FindFirst, FindNext;
  59.  
  60. FROM file IMPORT
  61. (* CONST*) fOK,
  62. (* TYPE *) modeT,
  63. (* PROC *) access;
  64.  
  65. FROM pSTORAGE IMPORT
  66. (* PROC *) ALLOCATE, DEALLOCATE;
  67.  
  68. (*==========================================================================*)
  69.  
  70. TYPE
  71.   TOSDIRPtr = POINTER TO TOSDIRType;
  72.  
  73.   TOSDIRState = (STARTSEARCH, INSEARCH, NMFILE);
  74.   TOSDIRType = RECORD
  75.     status  : TOSDIRState;
  76.     dta     : DTA;
  77.     dirname : PathName;
  78.     dirent  : DirentRec;
  79.     dname   : ARRAY [0..13] OF CHAR;
  80.   END;
  81.  
  82. CONST
  83.   (* Absicherung gegen ``unendlich'' grosse Datei- und Pfadnamen *)
  84.   MaxPathAlloc = 2047;
  85.  
  86. TYPE
  87.   PathBuf = ARRAY [0..MaxPathAlloc] OF CHAR;
  88.  
  89.   MiNTDIRPtr = POINTER TO MiNTDIRType;
  90.  
  91.   MiNTDIRType = RECORD
  92.     dsize   : UNSIGNEDLONG; (* (Tatsaechliche) Groesse des RECORDs *)
  93.     bsize   : UNSIGNEDLONG; (* (Tatsaechliche) Groesse von 'dino' + 'dname' *)
  94.     dhandle : UNSIGNEDLONG;
  95.     dirent  : DirentRec;
  96.     dino    : UNSIGNEDLONG;
  97.     dname   : PathBuf;
  98.     (* Fuer 'dname' wird nur soweit noetig Speicher angefordert. *)
  99.   END;
  100.  
  101. VAR
  102.   MiNT : BOOLEAN;
  103.  
  104. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  105.  
  106. PROCEDURE mkdir ((* EIN/ -- *) REF dir  : ARRAY OF CHAR;
  107.                  (* EIN/ -- *)     mode : modeT         ): INTEGER;
  108.  
  109. VAR res   : INTEGER;
  110.     dot   : BOOLEAN;
  111.     done  : BOOLEAN;
  112.     stack : ADDRESS;
  113.     msize : CARDINAL;
  114.     path0 : StrPtr;
  115.  
  116. BEGIN
  117.  IF access(dir, fOK) = 0 THEN
  118.    e.errno := e.EEXIST;
  119.    RETURN(-1);
  120.  ELSIF (e.errno <> e.ENOENT) AND (e.errno <> e.ENOTDIR) THEN
  121.    RETURN(-1);
  122.  END;
  123.  
  124.  msize := SLEN(dir) + DINCR;
  125.  memalloc(VAL(sizeT,msize), stack, path0);
  126.  UnixToDos(dir, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  127.  IF NOT done THEN
  128.    memdealloc(stack);
  129.    RETURN(-1);
  130.  END;
  131.  
  132.  IF NOT Dcreate(path0, res) THEN
  133.    e.errno := res;
  134.    memdealloc(stack);
  135.    RETURN(-1);
  136.  END;
  137.  IF MiNT THEN
  138.    done := Fchmod(path0, mode, res);
  139.  END;
  140.  memdealloc(stack);
  141.  RETURN(0);
  142. END mkdir;
  143.  
  144. (*---------------------------------------------------------------------------*)
  145.  
  146. PROCEDURE rmdir ((* EIN/ -- *) REF dir : ARRAY OF CHAR ): INTEGER;
  147.  
  148. VAR res   : INTEGER;
  149.     dot   : BOOLEAN;
  150.     done  : BOOLEAN;
  151.     stack : ADDRESS;
  152.     msize : CARDINAL;
  153.     path0 : StrPtr;
  154.  
  155. BEGIN
  156.  msize := SLEN(dir) + DINCR;
  157.  memalloc(VAL(sizeT,msize), stack, path0);
  158.  UnixToDos(dir, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  159.  IF NOT done THEN
  160.    memdealloc(stack);
  161.    RETURN(-1);
  162.  END;
  163.  
  164.  IF Ddelete(path0, res) THEN
  165.    res := 0;
  166.  ELSE
  167.    IF res = e.eACCDN THEN
  168.      e.errno := e.ENOTEMPTY;
  169.    ELSE
  170.      e.errno := res;
  171.    END;
  172.    res := -1;
  173.  END;
  174.  memdealloc(stack);
  175.  RETURN(res);
  176. END rmdir;
  177.  
  178. (*---------------------------------------------------------------------------*)
  179.  
  180. PROCEDURE chdir ((* EIN/ -- *) REF dir : ARRAY OF CHAR ): INTEGER;
  181.  
  182. VAR old   : CARDINAL;
  183.     res   : INTEGER;
  184.     drvs  : UNSIGNEDLONG;
  185.     dot   : BOOLEAN;
  186.     done  : BOOLEAN;
  187.     start : UNSIGNEDWORD;
  188.     stack : ADDRESS;
  189.     msize : CARDINAL;
  190.     path0 : StrPtr;
  191.  
  192. BEGIN
  193.  msize := SLEN(dir) + DINCR;
  194.  memalloc(VAL(sizeT,msize), stack, path0);
  195.  UnixToDos(dir, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  196.  IF NOT done THEN
  197.    memdealloc(stack);
  198.    RETURN(-1);
  199.  END;
  200.  
  201.  (* aktuelles Laufwerk merken, fuer Fehlerfall *)
  202.  old := Dgetdrv();
  203.  
  204.  start := 0;
  205.  IF path0^[0] = 0C THEN
  206.    path0^[0] := DDIRSEP;
  207.    path0^[1] := 0C;
  208.  ELSIF path0^[1] = ':' THEN
  209.    (* neues Laufwerk setzen *)
  210.    drvs  := Dsetdrv(tocard(path0^[0]) - 10);
  211.    start := 2;
  212.  END;
  213.  
  214.  (* Pfad ohne Laufwerksangabe setzen *)
  215.  IF Dsetpath(ADDADR(path0, start), res) THEN
  216.    res := 0;
  217.  ELSE
  218.    e.errno := res;
  219.    drvs    := Dsetdrv(old);
  220.    res     := -1;
  221.  END;
  222.  memdealloc(stack);
  223.  RETURN(res);
  224. END chdir;
  225.  
  226. (*---------------------------------------------------------------------------*)
  227.  
  228. PROCEDURE getcwd ((* EIN/ -- *) buf    : StrPtr;
  229.                   (* EIN/ -- *) bufsiz : StrRange ): StrPtr;
  230.  
  231. VAR err   : INTEGER;
  232.     dlen  : INTEGER;
  233.     xlen  : INTEGER;
  234.     str1  : ARRAY [0..0] OF CHAR;
  235.     stack : ADDRESS;
  236.     msize : StrRange;
  237.     path0 : StrPtr;
  238.  
  239. BEGIN
  240.  msize := bufsiz + XDECR;
  241.  IF NOT MiNT AND (msize < PATHMAX) THEN
  242.    (* mindestens PATHMAX Zeichen Puffer fuer TOS bereitstellen *)
  243.    msize := PATHMAX;
  244.  END;
  245.  memalloc(VAL(sizeT,msize), stack, path0);
  246.  str1[0] := 0C;
  247.  IF CompletePath(CAST(StrPtr,ADR(str1)), msize, path0, dlen, err) THEN
  248.    DosToUnix(path0, bufsiz, buf, dlen, xlen);
  249.    memdealloc(stack);
  250.    IF xlen < VAL(INTEGER,bufsiz) THEN
  251.      RETURN(buf);
  252.    ELSE
  253.      e.errno := e.ERANGE;
  254.      RETURN(NULL);
  255.    END;
  256.  ELSIF err = e.eRANGE THEN
  257.    e.errno := e.ERANGE;
  258.  ELSE
  259.    e.errno := err;
  260.  END;
  261.  memdealloc(stack);
  262.  RETURN(NULL);
  263. END getcwd;
  264.  
  265. (*--------------------------------------------------------------------------*)
  266.  
  267. PROCEDURE opendir ((* EIN/ -- *) REF dir : ARRAY OF CHAR ): DIR;
  268.  
  269. VAR tdir   : TOSDIRPtr;
  270.     err    : INTEGER;
  271.     ret    : DIR;
  272.     lenDir : INTEGER;
  273.     dot    : BOOLEAN;
  274.     done   : BOOLEAN;
  275.     drive  : ARRAY [0..1] OF CHAR;
  276.     stack  : ADDRESS;
  277.     msize  : CARDINAL;
  278.     path0  : StrPtr;
  279.     nlen   : SIGNEDLONG;
  280.     mdir   : MiNTDIRPtr;
  281.  
  282. BEGIN
  283.  msize := SLEN(dir) + DINCR;
  284.  memalloc(VAL(sizeT,msize), stack, path0);
  285.  UnixToDos(dir, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  286.  IF NOT done THEN
  287.    memdealloc(stack);
  288.    RETURN(NULL);
  289.  END;
  290.  
  291.  ret := NULL;
  292.  IF MiNT THEN
  293.    IF Dpathconf(path0, 3, nlen) THEN
  294.      (* Feststellen, welche Maximalgroesse Dateinamen haben. *)
  295.      IF nlen > VAL(SIGNEDLONG,TSIZE(PathBuf)) THEN
  296.        nlen := VAL(SIGNEDLONG,TSIZE(MiNTDIRType));
  297.      ELSE
  298.        nlen :=   VAL(SIGNEDLONG,TSIZE(MiNTDIRType) - TSIZE(PathBuf))
  299.                + nlen
  300.                + LIC(5); (* Fuer abschliessendes Nullbyte & Sicherheit *)
  301.      END;
  302.      ALLOCATE(mdir, nlen);
  303.      IF mdir = NULL THEN
  304.        e.errno := e.ENOMEM; (* vielleicht bessser: EMFILE ? *)
  305.      ELSE
  306.        WITH mdir^ DO
  307.          dsize := VAL(UNSIGNEDLONG,nlen);
  308.          bsize := dsize - VAL(UNSIGNEDLONG,ABS(DIFADR(ADR(dino), ADR(dsize))));
  309.          IF Dopendir(path0, 0, dhandle) THEN
  310.            ret := CAST(DIR,mdir);
  311.          ELSE
  312.            e.errno := INT(dhandle);
  313.            DEALLOCATE(mdir, nlen);
  314.          END;
  315.        END;
  316.      END;
  317.    ELSE
  318.      e.errno := INT(nlen);
  319.    END;
  320.    memdealloc(stack);
  321.    RETURN(ret);
  322.  END;
  323.  
  324.  NEW(tdir);
  325.  IF tdir = NULL THEN
  326.    e.errno := e.ENOMEM; (* vielleicht bessser: EMFILE ? *)
  327.    memdealloc(stack);
  328.    RETURN(NULL);
  329.  END;
  330.  
  331.  WITH tdir^ DO
  332.    (* vollstaendigen Pfad mit Laufwerksangabe merken, damit bei
  333.     * "rewinddir()" das richtige Verzeichnis benutzt wird, falls
  334.     * sich das aktuelle Verzeichnis inzwischen aendert.
  335.     *)
  336.    IF NOT CompletePath(path0,
  337.                        PATHMAX + 1, CAST(StrPtr,ADR(dirname)),
  338.                        lenDir,
  339.                        err)
  340.    THEN
  341.      DISPOSE(tdir);
  342.      tdir    := NULL;
  343.      e.errno := err;
  344.    ELSE
  345.      (* alle Dateien finden *)
  346.      IF dirname[VAL(UNSIGNEDWORD,lenDir-1)] = DDIRSEP THEN
  347.        APPEND("*.*", dirname);
  348.      ELSE
  349.        APPEND("\*.*", dirname);
  350.      END;
  351.  
  352.      IF FindFirst(CAST(StrPtr,ADR(dirname)), FINDALL, dta, err) THEN
  353.        status := STARTSEARCH;
  354.      ELSIF err = e.eFILNF THEN
  355.        status := NMFILE;
  356.      ELSE
  357.        DISPOSE(tdir);
  358.        tdir    := NULL;
  359.        e.errno := err;
  360.      END;
  361.    END;
  362.  END; (* WITH tdir^ *)
  363.  memdealloc(stack);
  364.  RETURN(CAST(DIR,tdir));
  365. END opendir;
  366.  
  367. (*---------------------------------------------------------------------------*)
  368.  
  369. PROCEDURE readdir ((* EIN/ -- *) dirp : DIR ): DirentPtr;
  370.  
  371. VAR err  : INTEGER;
  372.     tdir : TOSDIRPtr;
  373.     mdir : MiNTDIRPtr;
  374.  
  375. BEGIN
  376.  IF dirp = NULL THEN
  377.    e.errno := e.EBADF;
  378.    RETURN(NULL);
  379.  END;
  380.  
  381.  IF MiNT THEN
  382.    mdir := CAST(MiNTDIRPtr,dirp);
  383.    WITH mdir^ DO
  384.      IF NOT Dreaddir(VAL(CARDINAL,bsize), dhandle, ADR(dino), err) THEN
  385.        IF err <> e.eNMFIL THEN
  386.          e.errno := err;
  387.        END;
  388.        RETURN(NULL);
  389.      END;
  390.      dirent.dName := CAST(StrPtr,ADR(dname));
  391.      RETURN(CAST(DirentPtr,ADR(dirent)));
  392.    END;
  393.  END;
  394.  
  395.  tdir := CAST(TOSDIRPtr,dirp);
  396.  WITH tdir^ DO
  397.    IF status = NMFILE THEN
  398.      RETURN(NULL);
  399.    ELSIF status = STARTSEARCH THEN
  400.      status := INSEARCH;
  401.    ELSE
  402.      IF NOT FindNext(dta, err) THEN
  403.        IF err = e.eNMFIL THEN
  404.          status := NMFILE;
  405.        ELSE
  406.          e.errno := err;
  407.        END;
  408.        RETURN(NULL);
  409.      END;
  410.    END;
  411.    ASSIGN(dta.name, dname);
  412.    LOWER(dname);
  413.    dirent.dName := CAST(StrPtr,ADR(dname));
  414.    RETURN(CAST(DirentPtr,ADR(dirent)));
  415.  END; (* WITH tdir^ *)
  416. END readdir;
  417.  
  418. (*---------------------------------------------------------------------------*)
  419.  
  420. PROCEDURE rewinddir ((* EIN/ -- *) dirp : DIR );
  421.  
  422. VAR err  : INTEGER;
  423.     tdir : TOSDIRPtr;
  424.     mdir : MiNTDIRPtr;
  425.     done : BOOLEAN;
  426.  
  427. BEGIN
  428.  IF dirp <> NULL THEN
  429.    IF MiNT THEN
  430.      mdir := CAST(MiNTDIRPtr,dirp);
  431.      done := Drewinddir(mdir^.dhandle, err);
  432.    ELSE
  433.      tdir := CAST(TOSDIRPtr,dirp);
  434.      WITH tdir^ DO
  435.        IF FindFirst(CAST(StrPtr,ADR(dirname)), FINDALL, dta, err) THEN
  436.          status := STARTSEARCH;
  437.        ELSE
  438.          status := NMFILE;
  439.        END;
  440.      END;
  441.    END;
  442.  END;
  443. END rewinddir;
  444.  
  445. (*---------------------------------------------------------------------------*)
  446.  
  447. PROCEDURE closedir ((* EIN/AUS *) VAR dirp : DIR ): INTEGER;
  448.  
  449. VAR tdir : TOSDIRPtr;
  450.     res  : INTEGER;
  451.     mdir : MiNTDIRPtr;
  452.  
  453. BEGIN
  454.  IF dirp = NULL THEN
  455.    e.errno := e.EBADF;
  456.    RETURN(-1);
  457.  END;
  458.  res := 0;
  459.  IF MiNT THEN
  460.    mdir := CAST(MiNTDIRPtr,dirp);
  461.    IF NOT Dclosedir(mdir^.dhandle, res) THEN
  462.      e.errno := res;
  463.      res     := -1;
  464.    END;
  465.    DEALLOCATE(mdir, mdir^.dsize);
  466.  ELSE
  467.    tdir := CAST(TOSDIRPtr,dirp);
  468.    DISPOSE(tdir);
  469.  END;
  470.  dirp := NULL;
  471.  RETURN(res);
  472. END closedir;
  473.  
  474. (*--------------------------------------------------------------------------*)
  475.  
  476. PROCEDURE unlink ((* EIN/ -- *) REF file : ARRAY OF CHAR ): INTEGER;
  477.  
  478. VAR res   : INTEGER;
  479.     done  : BOOLEAN;
  480.     dot   : BOOLEAN;
  481.     stack : ADDRESS;
  482.     msize : CARDINAL;
  483.     path0 : StrPtr;
  484.  
  485. BEGIN
  486.  msize := SLEN(file) + DINCR;
  487.  memalloc(VAL(sizeT,msize), stack, path0);
  488.  UnixToDos(file, msize - DINCR, VAL(StrRange,msize), path0, dot, done);
  489.  IF NOT done THEN
  490.    memdealloc(stack);
  491.    RETURN(-1);
  492.  END;
  493.  
  494.  IF Fdelete(path0, res) THEN
  495.    res := 0;
  496.  ELSE
  497.    e.errno := res;
  498.    res     := -1;
  499.  END;
  500.  memdealloc(stack);
  501.  RETURN(res);
  502. END unlink;
  503.  
  504. (*--------------------------------------------------------------------------*)
  505.  
  506. PROCEDURE link ((* EIN/ -- *) REF old : ARRAY OF CHAR;
  507.                 (* EIN/ -- *) REF new : ARRAY OF CHAR ): INTEGER;
  508.  
  509. VAR dot    : BOOLEAN;
  510.     done1  : BOOLEAN;
  511.     done2  : BOOLEAN;
  512.     res    : INTEGER;
  513.     path01 : StrPtr;
  514.     path02 : StrPtr;
  515.     stack  : ADDRESS;
  516.     void   : ADDRESS;
  517.     msize1 : CARDINAL;
  518.     msize2 : CARDINAL;
  519.  
  520. BEGIN
  521.  IF MiNT THEN
  522.    msize1 := SLEN(old) + DINCR;
  523.    msize2 := SLEN(new) + DINCR;
  524.    memalloc(VAL(sizeT,msize1), stack, path01);
  525.    memalloc(VAL(sizeT,msize2), void, path02);
  526.    UnixToDos(old, msize1 - DINCR, VAL(StrRange,msize1), path01, dot, done1);
  527.    UnixToDos(new, msize2 - DINCR, VAL(StrRange,msize2), path02, dot, done2);
  528.    IF NOT (done1 AND done2) THEN
  529.      memdealloc(stack);
  530.      RETURN(-1);
  531.    END;
  532.  
  533.    IF Flink(path01, path02, res) THEN
  534.      res := 0;
  535.    ELSE
  536.      e.errno := res;
  537.      res     := -1;
  538.    END;
  539.    memdealloc(stack);
  540.    RETURN(res);
  541.  ELSE
  542.    e.errno := e.ENOSYS;
  543.    RETURN(-1);
  544.  END;
  545. END link;
  546.  
  547. (*--------------------------------------------------------------------------*)
  548.  
  549. PROCEDURE symlink ((* EIN/ -- *) REF old : ARRAY OF CHAR;
  550.                    (* EIN/ -- *) REF new : ARRAY OF CHAR ): INTEGER;
  551.  
  552. VAR dot    : BOOLEAN;
  553.     done1  : BOOLEAN;
  554.     done2  : BOOLEAN;
  555.     res    : INTEGER;
  556.     path01 : StrPtr;
  557.     path02 : StrPtr;
  558.     stack  : ADDRESS;
  559.     void   : ADDRESS;
  560.     msize1 : CARDINAL;
  561.     msize2 : CARDINAL;
  562.  
  563. BEGIN
  564.  IF MiNT THEN
  565.    msize1 := SLEN(old) + DINCR;
  566.    msize2 := SLEN(new) + DINCR;
  567.    memalloc(VAL(sizeT,msize1), stack, path01);
  568.    memalloc(VAL(sizeT,msize2), void, path02);
  569.    UnixToDos(old, msize1 - DINCR, VAL(StrRange,msize1), path01, dot, done1);
  570.    UnixToDos(new, msize2 - DINCR, VAL(StrRange,msize2), path02, dot, done2);
  571.    IF NOT (done1 AND done2) THEN
  572.      memdealloc(stack);
  573.      RETURN(-1);
  574.    END;
  575.  
  576.    IF Fsymlink(path01, path02, res) THEN
  577.      res := 0;
  578.    ELSE
  579.      e.errno := res;
  580.      res     := -1;
  581.    END;
  582.    memdealloc(stack);
  583.    RETURN(res);
  584.  ELSE
  585.    e.errno := e.ENOSYS;
  586.    RETURN(-1);
  587.  END;
  588. END symlink;
  589.  
  590. (*--------------------------------------------------------------------------*)
  591.  
  592. PROCEDURE readlink ((* EIN/ -- *) REF lname  : ARRAY OF CHAR;
  593.                     (* EIN/ -- *)     buf    : StrPtr;
  594.                     (* EIN/ -- *)     bufsiz : StrRange      ): INTEGER;
  595.  
  596. VAR dot    : BOOLEAN;
  597.     done   : BOOLEAN;
  598.     res    : INTEGER;
  599.     xlen   : INTEGER;
  600.     path01 : StrPtr;
  601.     path02 : StrPtr;
  602.     stack  : ADDRESS;
  603.     void   : ADDRESS;
  604.     msize1 : CARDINAL;
  605.     msize2 : CARDINAL;
  606.  
  607. BEGIN
  608.  IF MiNT THEN
  609.    msize1 := SLEN(lname) + DINCR;
  610.    msize2 := bufsiz + XDECR;
  611.    memalloc(VAL(sizeT,msize1), stack, path01);
  612.    memalloc(VAL(sizeT,msize2), void, path02);
  613.    UnixToDos(lname, msize1 - DINCR, VAL(StrRange,msize1), path01, dot, done);
  614.    IF NOT done THEN
  615.      memdealloc(stack);
  616.      RETURN(-1);
  617.    END;
  618.  
  619.    IF NOT Freadlink(msize2, path02, path01, res) AND (res <> e.eRANGE) THEN
  620.      e.errno := res;
  621.      res     := -1;
  622.    ELSE
  623.      DosToUnix(path02, bufsiz, buf, res, xlen);
  624.      IF xlen > INT(bufsiz) THEN
  625.        res := INT(bufsiz);
  626.      ELSE
  627.        res := xlen;
  628.      END;
  629.    END;
  630.    memdealloc(stack);
  631.    RETURN(res);
  632.  ELSE
  633.    e.errno := e.ENOSYS;
  634.    RETURN(-1);
  635.  END;
  636. END readlink;
  637.  
  638. (*--------------------------------------------------------------------------*)
  639.  
  640. PROCEDURE rename ((* EIN/ -- *) REF old : ARRAY OF CHAR;
  641.                   (* EIN/ -- *) REF new : ARRAY OF CHAR ): INTEGER;
  642.  
  643. VAR res    : INTEGER;
  644.     done1  : BOOLEAN;
  645.     done2  : BOOLEAN;
  646.     dot    : BOOLEAN;
  647.     path01 : StrPtr;
  648.     path02 : StrPtr;
  649.     stack  : ADDRESS;
  650.     void   : ADDRESS;
  651.     msize1 : CARDINAL;
  652.     msize2 : CARDINAL;
  653.  
  654. BEGIN
  655.  msize1 := SLEN(old) + DINCR;
  656.  msize2 := SLEN(new) + DINCR;
  657.  memalloc(VAL(sizeT,msize1), stack, path01);
  658.  memalloc(VAL(sizeT,msize2), void, path02);
  659.  UnixToDos(old, msize1 - DINCR, VAL(StrRange,msize1), path01, dot, done1);
  660.  UnixToDos(new, msize2 - DINCR, VAL(StrRange,msize2), path02, dot, done2);
  661.  IF NOT (done1 AND done2) THEN
  662.    memdealloc(stack);
  663.    RETURN(-1);
  664.  END;
  665.  
  666.  IF strcmp(path01, path02) = 0 THEN
  667.    (* sonst wird die Datei nachher geloescht... *)
  668.    (* Vergleich erst NACH "UnixToDos()", da unterschiedliche *IX-Namen
  669.     * evtl. auf denselben DOS-Namen abgebildet werden!
  670.     *)
  671.    memdealloc(stack);
  672.    RETURN(0);
  673.  END;
  674.  
  675.  IF access(new, fOK) = 0 THEN
  676.    (* vorhandene Zieldatei zuvor loeschen, falls nicht schreibgeschuetzt,
  677.     * da "GEMDOS" evtl. einen doppelten Name nicht erkennt. Wenn dabei
  678.     * allerdings ein Fehler auftritt, ist die Zieldatei verloren!
  679.     *)
  680.  
  681.    IF NOT Fdelete(path02, res) THEN
  682.      e.errno := res;
  683.      memdealloc(stack);
  684.      RETURN(-1);
  685.    END;
  686.  END;
  687.  
  688.  IF Frename(path01, path02, res) THEN
  689.    res := 0;
  690.  ELSE
  691.    e.errno := res;
  692.    res     := -1;
  693.  END;
  694.  memdealloc(stack);
  695.  RETURN(res);
  696. END rename;
  697.  
  698. (*==========================================================================*)
  699.  
  700. BEGIN (* dir *)
  701.  MiNT := MiNTVersion() > 0;
  702. END dir.
  703.